home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 21 / AMIGAplus Sonderheft 21 (1999)(ICP)(DE)[!].iso / PublicDomain / System / httplister / arexx / HTTPlister.rexx
OS/2 REXX Batch file  |  1999-08-23  |  22KB  |  938 lines
  1. /* $VER:    HTTPlister.rexx 1.9 1999
  2.    Copyright © 1998 Brian Scott
  3.    Email: bscott@odyssey.apana.org.au
  4. */
  5.  
  6. /* *** HTTPResume by Andrija Antonijevics IS REQUIRED. ***
  7.  
  8. This ARexx script reads and lists an aminet listing either the RECENT
  9.    file or another of the same format into a Dopus lister.
  10.  
  11.    You get 3 columns, Name, Comment & Date giving you the instant sorting
  12.    that Dopus provides in any column by selecting either the 'Name',
  13.    'Comment' or 'Date' column labels in the lister.
  14.  
  15.    The aminet file's Dir, Size & Desc. go in the 'Comment' column.
  16.  
  17.    Selecting the 'Comment' label in the lister gets all the aminet
  18.    directories sorted into groups.
  19.  
  20.    Selecting the 'Date' label in the lister gets all the lines sorted in
  21.    the same order as they were in the file they came from. (The 'dates'
  22.    are meaningless - generated for sorting purposes only).
  23.  
  24.    It is actually the 'time' part of the date field that gets incremented,
  25.    the dates remain constant.
  26.  
  27.    o The most downloaded files from Aminet during the week have the date
  28.      22-Feb-88.
  29.  
  30.    o The highest rated programs during the week have the date 30-Mar-98.
  31.  
  32.    o The rest have the date 01-Jan-78.
  33.  
  34.    By adding aminet direc/tories to the FilterOut string below,
  35.    you can prevent some from being listed in the lister.
  36.    Check it out as I've left a couple there as examples and you may
  37.    want to list them.
  38.  
  39.    When you run this script from a Dopus menu etc. set the flag
  40.    Run asynchronously.
  41.  
  42.    YOU WILL NEED TO CHANGE THE VALUE OF THESE VARIABLES:
  43.    ----------------------------------------------------
  44.     o HTTPresume (HTTPresume with it's full path)
  45.     o PRXY       (Your proxy:port) /* See the HTTPResume docs on setting PROXY */
  46.     o amiURL      Your aminet URL (Should start with http://)
  47.     o and as mentioned the FilterOut string will need editing.
  48.  
  49.    If you wish to use this without a proxy remove the PRXY variable line and
  50.    make sure that the aminet URL (amiURL variable below) you choose starts
  51.    with 'http://' and not 'ftp://'. (This comes from someone that doesn't
  52.    use a proxy. I use one so I can't test this).
  53.  
  54.    And if you like you can free up the sound system below. For indicating
  55.    when the downloading has finished.
  56.  
  57. Note!
  58.  * This is strictly USE AT YOUR OWN RISK.
  59.  * This has only been tested with Directory Opus 5.661 Magellan and
  60.  * HTTPResume 1.3.
  61.  * The names listed in the lister are only pseudo-files and can't be
  62.  * treated as you would other file names in normal listers. Only apply
  63.  * the actions that I outline and it should all work OK.
  64.  
  65. */
  66.  
  67. /***** Main Variables *********/
  68.  
  69.               /* As many as you like, that you DON'T want in the lister. */
  70. FilterOut   = "comm/ambos comm/bbs comm/cnet"  /* eg. */
  71.  
  72. HTTPresume  = 'DATA:COMM/WEB/HTTPResume/HTTPResume'
  73.  
  74. PRXY        = "HTTP://anonymous:you@where.ever.you.are:8080"
  75.  
  76.              /* Suit yourself for your aminet URL */
  77. amiURL.0    = 3  /* Set this to how many amiURLs do you have.     */
  78.  
  79.     /* amiURL.1 is always the default when HTTPlister.rexx starts up. */
  80. amiURL.1   = "http://ftp.uni-paderborn.de/pub/aminet/"        /* Germany   ALL */
  81. amiURL.2   = "http://sunsite.doc.ic.ac.uk/packages/amiga/"    /* UK        ?   */
  82. amiURL.3   = "http://ftp.wustl.edu/pub/aminet/"               /* USA (MO)  ALL */
  83.  
  84. DDir        = "RAM:"  /* Where the downloaded files will end up. */
  85.  
  86. /***** Start of Sound System setup *********/
  87.  
  88.    /* You'll need to free this up (remove the comment tags)
  89.       and give paths etc. for your player and sound file.
  90.     */
  91.  
  92. /* For the system to work REMOVE THIS LINE..
  93. soundafter  = 300  /* Only play a sound (to notify finish of downloading)    */
  94.                    /* if it takes longer than this many seconds to download. */
  95.  
  96.   /* Find sound files at http://www.moviesounds.com/ */
  97. fini_sound  = "DATA:COMM/Sound/12-1234.wav"
  98.  
  99. soundplayer = "c:play16"
  100.  
  101.   /* eg. of how it's run.. ADDRESS command soundplayer||" >nil: "||fini_sound */
  102.  
  103. */ ..and REMOVE THIS LINE too for the sound system to work
  104.  
  105. /***** End of Sound System setup *********/
  106.  
  107. /******                                                           **********/
  108. /*****  It's All Action from here on.. (Tamper at your own peril.) *********/
  109. /******                                                           **********/
  110. parse arg listingfyl
  111.  
  112. ADDRESS 'DOPUS.1'
  113. OPTIONS RESULTS
  114. OPTIONS failat 40
  115. signal on syntax
  116. LF = '0a'x
  117.  
  118. dopus version
  119. If ( result='RESULT' | translate(result,'.',' ') < 5.1218 ) then do
  120.     dopus request '"This script requires DOpus v5.5 or greater." OK'
  121.     EXIT
  122.     end
  123.  
  124. httpargs = sethttparg(DDir)
  125.  
  126. oldsel     = 0
  127. tick       = 1
  128. amiURL     = amiURL.tick
  129. maxsgsz    = 3000   /* Msg of day size to show in Req. Larger gets Read. */
  130. HTTPlabel  = "HTTPlister"
  131. topdefault = "Aminet listing"
  132. toploading = 'Loading list..'
  133. prefile    = "sys:s/httppreselected"
  134. Amotd      = ""
  135.  
  136. HTTPToolBar = "GETAMINET.BUTTONS"
  137.  
  138. if ~show('L','rexxsupport.library') then
  139.    addlib('rexxsupport.library',0,-30,0)
  140.  
  141. if listingfyl = "" then listingfyl = slcd()
  142.  
  143. if listingfyl ~= "" then do
  144.  
  145.    listingOK = chkfyl(listingfyl) /* Returns with the listing file still open. */
  146.    
  147.    if ~listingOK then do
  148.       CALL close('r')
  149.       CALL tata(listingfyl||LF||'"Doesn''t contain an aminet listing."')
  150.       end
  151.    
  152.    ln = chkln  /* The first line that proved to be of aminet format. */
  153.  
  154.    running = chkrunning()  /* Check if HTTPlister is already running, if it is */
  155.                            /* use the same lister to view an incoming list.    */
  156.    if running > 0 then do
  157.       CALL loadrunning(running)
  158.       if Amotd ~= "" then CALL readAmotd()  /* Message of the day. */
  159.       CALL chkpresel()   /* Check for preselected file names. */
  160.       EXIT
  161.       end
  162.    end
  163.  
  164. lister new "1/11/690/425 "
  165. ALH = result
  166.  
  167. lister set ALH TOOLBAR HTTPToolBar   /* getaminet.buttons */
  168. lister set ALH display name comment date
  169. lister set ALH source
  170. lister set ALH title toploading
  171. lister set ALH label HTTPlabel
  172.  
  173. lister clear ALH
  174. lister refresh ALH full
  175.  
  176. if listingfyl ~= "" then do
  177.    lister set ALH busy 1
  178.    CALL loadlist()    /* Listing file gets closed here. */
  179.    topmsg = gettopmsg(listingfyl)
  180.    lister set ALH busy 0
  181.    end
  182. else topmsg = "Waiting for RECENT file:"
  183.  
  184. lister set ALH title topmsg
  185. lister refresh ALH full
  186.  
  187. handlername = "_HTTPlister"
  188.  
  189. dopus addtrap '*' handlername     /* Trap all dopus commands. */
  190.  
  191. dopus remtrap 'none' handlername  /* UnSelect button uses 'none' */
  192.  
  193. if Amotd ~= "" then CALL readAmotd()
  194.  
  195. CALL chkpresel()   /* Check for preselected file names. */
  196.  
  197. lister set ALH handler handlername
  198. CALL openport(handlername)
  199.  
  200. do until event='inactive'
  201.    if waitpkt(handlername) then do
  202.       packet=getpkt(handlername)
  203.  
  204.       if packet~='00000000'x then do
  205.  
  206.          event=getarg(packet,0)
  207.          desti=getarg(packet,1)
  208.          namestr=getarg(packet,2)
  209.          user=getarg(packet,3)
  210.          pathstr=getarg(packet,4)
  211.          reqreturn=getarg(packet,5)
  212.          qualifier=getarg(packet,6)
  213.  
  214.          CALL delay(10)
  215.  
  216.          select
  217.             when (qualifier='shift') & (event='doubleclick') then
  218.                CALL readOPT()
  219.             when event='dereselect' then    /* De-Reselect */
  220.                oldsel = dereselect(oldsel)
  221.             when event='preselect' then     /* Preselect */
  222.                CALL preselect()
  223.             when event='dlselected' then
  224.                CALL downloadOPT()
  225.             when event='chgurl' then do
  226.                amiURL = chngURL()
  227.                CALL timedmsg(amiURL, 75)
  228.                end
  229.             when event='showurl' then       /* Show current URL */
  230.                CALL timedmsg(amiURL, 80)
  231.             when event='search' then do
  232.                lister set ALH source
  233.                lister set ALH busy 1
  234.                CALL findstring()
  235.                lister set ALH busy 0
  236.                end
  237.             when (event='doubleclick') then CALL timedmsg("'Shift-Select' for .readme", 150)
  238.             when (event='dlrecent') then do
  239.                gotrcnt = downloadrcnt()
  240.                if ~gotrcnt then
  241.                   CALL givemsg('"RECENT failed to download!"')
  242.                else do
  243.                   CALL load("RAM:RECENT")
  244.                   if Amotd ~= "" then CALL readAmotd()
  245.                   end
  246.                end
  247.             when (event='drop') then do
  248.                if words(namestr) = 1 then do
  249.                   lister query user path
  250.                   reqreturn = result||namestr
  251.                   Amotd = ""
  252.                   CALL load(reqreturn)
  253.                   if Amotd ~= "" then CALL readAmotd()
  254.                   CALL chkpresel()   /* Check for preselected file names. */
  255.                   end
  256.                else CALL givemsg('"You need to provide ONE aminet listing file."')
  257.                end
  258.             when (qualifier='shift') & (event='dropfrom') then do
  259.                lister query user busy
  260.                if ~result then do
  261.                   if words(namestr) = 1 then do
  262.                      DDir = reqreturn
  263.                      Dhandle = user     /* Adopt lister for downloading */
  264.                      CALL readOPT()
  265.                      end
  266.                   else
  267.                      CALL givemsg('"Sorry only ONE readme at a time."')
  268.                   end
  269.                end
  270.             when (event='dropfrom') then do
  271.                lister query user busy
  272.                if ~result then do
  273.                   DDir = reqreturn
  274.                   Dhandle = user
  275.                   lister set user dest
  276.                   lister refresh user
  277.                   do s = 1 to words(namestr) /* 'dropfrom' de-selected them. */
  278.                      lister select ALH word(namestr,s) on
  279.                      end
  280.                   lister refresh ALH
  281.  
  282.                   CALL downloadOPT()
  283.                   end  
  284.                end
  285.             otherwise NOP
  286.             end
  287.  
  288.          CALL reply(packet,0)
  289.          end
  290.       end
  291.    end
  292.  
  293. CALL closeport(handlername)
  294.  
  295.  
  296. EXIT
  297.  
  298.  
  299. readOPT:
  300. lister set ALH busy 1
  301. httpargs = sethttparg(DDir)
  302. CALL gogetrm(namestr)
  303. lister set ALH busy 0
  304. if exists(DDir||refyl) then do
  305.    dopus read DDir||refyl
  306.    if event='dropfrom' then CALL showdownloads()
  307.    end
  308. else
  309.    CALL givemsg(refyl||'" not downloaded!"')
  310.  
  311. RETURN
  312.  
  313.  
  314. dereselect: procedure expose ALH reselfile.
  315. arg oldsel
  316.  
  317. lister query ALH numselfiles
  318. totsel = result
  319.  
  320. if totsel > 0 then do
  321.    lister query ALH selfiles stem reselfile.
  322.    'command none'
  323.    end
  324. else do
  325.    do i = 0 to oldsel -1
  326.       lister select ALH reselfile.i on
  327.       end
  328.    end
  329. lister refresh ALH full
  330. RETURN totsel
  331.  
  332.  
  333. preselect: procedure expose ALH prefile
  334. lister query ALH numselfiles
  335. totsel = result
  336.  
  337. if totsel > 0 then do
  338.    lister query ALH selfiles var preselfiles
  339.    CALL open('w',prefile,'w')
  340.    CALL writeln('w',preselfiles)
  341.    CALL close('w')
  342.    'command none'
  343.    lister set ALH busy 0
  344.    lister refresh ALH full
  345.    end
  346. else CALL chkpresel()
  347. RETURN
  348.  
  349.  
  350. chkpresel:  procedure expose ALH prefile
  351. if exists(prefile) then do
  352.    CALL open('r',prefile,'r')
  353.    preselfiles = readln('r')
  354.    CALL close('r')
  355.  
  356.    wrdcnt = words(preselfiles)
  357.  
  358.    if wrdcnt > 0 then do
  359.       do i = 1 to wrdcnt
  360.          lister select ALH word(preselfiles,i) on
  361.          end
  362.       lister refresh ALH full
  363.       lister query ALH numselfiles
  364.       totsel = result
  365.       if totsel > 0 then do
  366.         CALL givemsg(totsel||'" Re-selected"')   
  367.         if totsel = wrdcnt then ADDRESS command 'delete >NIL:' prefile
  368.         end
  369.       end
  370.    end
  371. RETURN
  372.  
  373.  
  374. downloadOPT:
  375. lister set ALH source
  376. lister set ALH busy 1
  377. httpargs = sethttparg(DDir)
  378. gotem = gogetem()
  379. lister set ALH busy 0
  380. if gotem then CALL showdownloads()
  381.  
  382. RETURN
  383.  
  384.  
  385. chngURL:
  386. tick = tick +1
  387.  
  388. if tick = amiURL.0 +1 then tick = 1
  389.  
  390. newurl = amiURL.tick
  391. if index(upper(amiURL.tick),"HTTP://") = 1 then newurl = right(amiURL.tick,length(amiURL.tick) -7)
  392.  
  393. RETURN newurl
  394.  
  395.  
  396. load:
  397. parse arg pthfyl
  398.  
  399. listingOK = chkfyl(pthfyl) /* Returns with file still open. */
  400.  
  401. if ~listingOK then do
  402.    CALL close('r')
  403.    CALL givemsg(pthfyl||LF||'"Doesn''t contain an aminet listing."')
  404.    end
  405. else do
  406.   lister set ALH source
  407.    ln = chkln
  408.    lister set ALH title toploading
  409.    lister refresh ALH full
  410.    lister set ALH busy 1
  411.    lister clear ALH
  412.    CALL loadlist()    /* File gets closed here. */
  413.    topmsg = gettopmsg(pthfyl)
  414.    lister set ALH busy 0
  415.    lister set ALH title topmsg
  416.    lister refresh ALH full
  417.    end
  418.  
  419. RETURN
  420.  
  421.  
  422. chkrunning:
  423. ALH = 0
  424.  
  425. lister query all var handles
  426.  
  427. hcount = words(handles)
  428.  
  429. do h = 1 to hcount
  430.    hndl = word(handles,h)
  431.    lister query hndl toolbar   /* query label doesn't want to work?! */
  432.    TB = upper(result)
  433.    if index(TB,HTTPToolBar) > 0 then do
  434.       ALH = hndl
  435.       leave
  436.       end
  437.    end
  438.  
  439. RETURN ALH
  440.  
  441.  
  442. loadrunning:
  443. arg ALH
  444.  
  445.    lister set ALH source
  446.    lister set ALH title toploading
  447.    lister set ALH busy 1
  448.    lister refresh ALH full
  449.    lister clear ALH
  450.    CALL loadlist()    /* File gets closed here. */
  451.    topmsg = gettopmsg(listingfyl)
  452.    
  453.    lister set ALH busy 0
  454.    lister set ALH title topmsg
  455.    lister refresh ALH full
  456.  
  457. RETURN
  458.  
  459.  
  460. loadlist:
  461.  
  462. lynnum = 0
  463. MDF = 0; HRP = 0
  464. Amotd  = ""
  465. LF     = '0a'x
  466.  
  467. do while ~EOF('r')
  468.    if ln ~= "" then do
  469.       if index(ln,"|") = 1 then do
  470.          MDF = 0; HRP = 0
  471.          do while index(ln,"|") = 1 & ~EOF('r')
  472.             select
  473.                when index(ln,"most downloaded files") > 0 then MDF = 1
  474.                when index(ln,"highest rated programs") > 0 then HRP = 1
  475.                otherwise NOP
  476.                end
  477.             ln = readln('r')
  478.             end
  479.          parse var ln +18 t1 +1 ap +10 t2 +1 .
  480.          if ~((t1||t2 == "  ") & (index(ap,"/") >0)) & (MDF | HRP) then do
  481.             MDF = 0; HRP = 0
  482.             end
  483.          end
  484.       if EOF('r') then LEAVE
  485.       parse var ln +18 t1 +1 ap +10 t2 +1 .
  486.       if index(ln,"Message of the day:") > 0 then do
  487.          do while ~EOF('r') & ~((t1||t2 == "  ") & (index(ap,"/") >0))
  488.             Amotd = Amotd||ln||LF
  489.             ln = readln('r')
  490.             parse var ln +18 t1 +1 ap +10 t2 +1 .
  491.             end
  492.          end
  493.       if EOF('r') then LEAVE
  494.       parse var ln aminame amidir amirest
  495.       if (index(FilterOut,amidir) = 0) & (t1||t2 == "  ") & (index(ap,"/") >0) then do
  496.          lynnum = lynnum +1
  497.          select
  498.            when MDF then linedayt = lynnum +320025661
  499.            when HRP then linedayt = lynnum +638755261
  500.            otherwise linedayt = lynnum
  501.            end
  502.          entry.name = aminame
  503.          entry.comment = amidir||amirest
  504.          entry.date = linedayt
  505.          lister addstem ALH entry
  506.          end
  507.       end
  508.  
  509.    ln = readln('r')
  510.  
  511.    end
  512.  
  513. CALL close('r')
  514.  
  515. RETURN
  516.  
  517.  
  518. gogetem:
  519. lister query ALH numselfiles
  520. totsel = result
  521.  
  522. gotsome   = 0
  523. numdwnldd = 0
  524.  
  525. if totsel ~> 0 then RETURN gotsome
  526.  
  527. lister query ALH selfiles stem fyl.
  528.  
  529. loadmsg = loadHTTPresume()
  530.  
  531. if loadmsg = "" then do
  532.    ADDRESS 'DOPUS.1'
  533.    do i = 0 to totsel -1
  534.       lister query ALH entry fyl.i stem fylinfo
  535.  
  536.       parse var fylinfo.comment amipath rest
  537.  
  538.       if totsel > 1 then
  539.          DLfsz.i = getasz(left(amipath||rest,16))
  540.  
  541.       Uset.i = amiURL||amipath||"/"||fyl.i
  542.       end
  543.  
  544.    tmp = time(reset)  /* set elapsed time to 0.00  */
  545.  
  546.    if totsel > 1 then do   /* Bubble smallest to highest */
  547.       do ii=0 to totsel -1
  548.          do j=ii+1 to totsel -1
  549.             if DLfsz.ii > DLfsz.j then parse value Uset.ii Uset.j fyl.ii fyl.j DLfsz.ii DLfsz.j with Uset.j Uset.ii fyl.j fyl.ii DLfsz.j DLfsz.ii .
  550.             end
  551.          end
  552.       end
  553.  
  554.    ADDRESS(Port)
  555.    
  556.    do J=0 to totsel-1
  557.       SET OUTFILE DDir||fyl.J
  558.       SET URL Uset.J
  559.       START
  560.       Working=1
  561.   
  562.       do while Working>0
  563.        QUERY FINISHED
  564.        Working=Result
  565.        CALL Delay(150) /* Pause 3 seconds */
  566.        end
  567.   
  568.       if exists(DDir||fyl.J) then do
  569.          numdwnldd = numdwnldd +1
  570.          CALL deselect(fyl.J)
  571.          ADDRESS(Port)
  572.          end
  573.  
  574.       end
  575.    
  576.    QUIT
  577.  
  578.    if (time(elapsed) >soundafter) & exists(soundplayer) & exists(fini_sound) then do
  579.       ADDRESS command soundplayer||" >nil: "||fini_sound
  580.       CALL delay(100)
  581.       end
  582.    else
  583.       CALL delay(150)
  584.  
  585.    ADDRESS 'DOPUS.1'
  586.    
  587.    lister query ALH numselfiles
  588.    numnotfound = result
  589.    
  590.    if numnotfound > 0 then CALL givemsg('"Number of files not downloaded: "'||numnotfound)
  591.    end
  592. else
  593.   CALL givemsg(loadmsg)
  594.  
  595. if numdwnldd > 0 then gotsome = 1
  596.  
  597. RETURN gotsome
  598.  
  599.  
  600. gogetrm:
  601. parse arg rf
  602.  
  603. parse var rf nm "." .
  604.  
  605. refyl = nm||".readme"
  606.  
  607. loadmsg = loadHTTPresume()
  608.  
  609. if loadmsg = "" then do
  610.    lister query ALH entry rf stem fylinfo
  611.    parse var fylinfo.comment amipath .
  612.    Uset  = amiURL||amipath||"/"||refyl
  613.    ADDRESS(Port)
  614.    
  615.    SET OUTFILE DDir||refyl
  616.    SET URL Uset
  617.    START
  618.    Working=1
  619.    do while Working>0
  620.       QUERY FINISHED
  621.       Working=Result
  622.       CALL Delay(150) /* Pause 3 seconds */
  623.       end
  624.  
  625.    QUIT
  626.    end
  627. else
  628.    CALL givemsg(loadmsg)
  629.  
  630. RETURN
  631.  
  632.  
  633. downloadrcnt:
  634. dlsucc = 0
  635. Uset = amiURL||"RECENT"
  636.  
  637. loadmsg = loadHTTPresume()
  638.  
  639. if loadmsg = "" then do
  640.    ADDRESS(Port)
  641.    
  642.    SET OUTFILE "RAM:RECENT"
  643.    SET URL Uset
  644.    START
  645.    Working=1
  646.  
  647.    do while Working>0
  648.     QUERY FINISHED
  649.     Working=Result
  650.     CALL Delay(150) /* Pause 3 seconds */
  651.     end
  652.   
  653.    QUIT
  654.  
  655.    if exists("RAM:RECENT") then dlsucc = 1
  656.  
  657.    end
  658. else
  659.   CALL givemsg(loadmsg)
  660.  
  661. RETURN dlsucc
  662.  
  663.  
  664. loadHTTPresume:
  665. succ = ""
  666.  
  667. TmpFile='T:HTTPResume.tmp.'||random(,,time('s'))||'.'random(,,)
  668.  
  669. ADDRESS COMMAND 'Run '||HTTPresume||httpargs||TmpFile
  670.  
  671. CALL Delay(150) /* Wait 3 seconds for HTTPResume to start */
  672.  
  673. if ~OPEN(PortFile, TmpFile, 'R') then
  674.    succ = '"Download failed! Possibly not online?"'
  675. else do
  676.    Port=READLN(PortFile)
  677.    CLOSE(PortFile)
  678.    CALL DELETE(TmpFile)
  679.    IF Port='***' then succ = '"HTTPResume couldn''t open its ARexx port!"'
  680.    end
  681.  
  682.  
  683. RETURN succ
  684.  
  685.  
  686. deselect: procedure expose ALH
  687. parse arg fyl
  688.  
  689. ADDRESS 'DOPUS.1'
  690. lister select ALH fyl off   /* De-select that file. */
  691. lister refresh ALH
  692.  
  693. RETURN
  694.  
  695.  
  696. showdownloads:
  697.  
  698. lister query all
  699. alltrs = result
  700.  
  701. stillopen = index(alltrs,Dhandle)
  702.  
  703. select
  704.   when stillopen > 0 then do
  705.     lister set Dhandle dest
  706.     lister read Dhandle DDir
  707.     end
  708.   when stillopen = 0 then do
  709.     lister new "1/200/350/200 " DDir
  710.     Dhandle = result
  711.     lister wait Dhandle
  712.     lister set Dhandle dest
  713.     end
  714.     otherwise NOP
  715.      end
  716.  
  717. RETURN
  718.  
  719.  
  720. slcd:
  721. rcnt = ""
  722.  
  723. lister query source; if RC > 0 then RETURN rcnt
  724. src = result
  725.  
  726. lister query src numselfiles
  727. totsel = result
  728.  
  729. if (totsel = 0) | (totsel > 1) then RETURN rcnt
  730.  
  731. lister query src path
  732. srcpth = result
  733.  
  734. lister query src selfiles stem fyl.
  735. amilist = fyl.0
  736.  
  737. rcnt = srcpth||amilist
  738.  
  739. lister select src amilist off   /* De-select that file. */
  740. lister refresh src
  741.  
  742. RETURN rcnt
  743.  
  744.  
  745. chkfyl: procedure expose chkln recdayt
  746. parse arg amilisting
  747.  
  748. rcntOK  = 1
  749. lncntr  = 0
  750. maxcnt  = 100
  751. recdayt = ""
  752.  
  753. if ~open('r',amilisting,'r') then CALL tata('"Can''t open "'||amilisting, 20)
  754.  
  755. chkln = readln('r')
  756.  
  757. parse var chkln +18 t1 +1 ap +10 t2 +1 .
  758.  
  759. do while ~EOF('r') & ~((t1||t2 == "  ") & (index(ap,"/") >0)) & ~(lncntr > maxcnt)
  760.    lncntr = lncntr +1
  761.    chkln = readln('r')
  762.    if index(chkln,"Date:") = 1 then recdayt = getrecdayt(chkln)
  763.    parse var chkln +18 t1 +1 ap +10 t2 +1 .
  764.    end
  765.  
  766. if EOF('r') | (lncntr > maxcnt) then do
  767.    CALL close('r')
  768.    rcntOK = 0
  769.    end
  770.  
  771. RETURN rcntOK
  772.  
  773.  
  774. getrecdayt:
  775. parse arg rdl
  776. rcd = ""
  777.  
  778. parse var rdl "Date:" . ", " dayt +11 rest
  779. if index("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec",word(dayt,2)) > 0 then rcd = dayt
  780.  
  781. RETURN rcd
  782.  
  783.  
  784. findstring: procedure expose ALH srchstr
  785.  
  786. oldstr = ""
  787.  
  788. if (srchstr ~= "SRCHSTR") & (srchstr ~= "RESULT") then oldstr = srchstr
  789.  
  790. dopus getstring '"Non-case sensitive search. Don''t use wild cards." "'||oldstr||'" Okay|Cancel'
  791. srchstr = result
  792. butt = DOPUSRC
  793.  
  794. Usrchstr = upper(srchstr)
  795.  
  796. if (srchstr="RESULT" & butt<1) | (butt=1 & srchstr="RESULT" ) then RETURN
  797.  
  798. lister query ALH  files stem filename.
  799.  
  800. lister query ALH  numfiles
  801. filecount = result
  802.  
  803. lister clear ALH  abort
  804. lister set ALH newprogress abort bar name title
  805. lister set ALH newprogress title "Searching both columns for "||srchstr
  806. lister set ALH newprogress bar numsel 0
  807.  
  808. do i = 0 to filecount-1
  809.  
  810.    lister set ALH newprogress name filename.i
  811.    lister set ALH newprogress bar filecount i
  812.  
  813.    lister query ALH entry filename.i stem fileinfo.
  814.    if index(upper(filename.i||fileinfo.comment),Usrchstr) > 0 then lister select ALH  filename.i 1
  815.  
  816.    lister query ALH abort
  817.    if result = 1 then do
  818.       lister set ALH newprogress off
  819.       lister refresh ALH full
  820.       RETURN
  821.       end
  822.  
  823.    end
  824.  
  825. lister set ALH  newprogress off
  826.  
  827. lister refresh ALH  full
  828.  
  829. RETURN
  830.  
  831.  
  832. gettopmsg:
  833. parse arg lstfyl
  834.  
  835.  tfnm = fylname(lstfyl)
  836.  if datatype(tfnm,'n') then 
  837.     topdefault = topdefault||" "||recdayt
  838.  else
  839.     topdefault = tfnm||" "||recdayt
  840.  
  841. RETURN topdefault
  842.  
  843.  
  844. fylname:
  845. parse arg fdir
  846. slpos = lastpos('/',fdir)
  847.  
  848. parse var fdir ":"fn
  849. if slpos > 0 then fn = substr(fdir,slpos+1)
  850.  
  851. RETURN fn
  852.  
  853.  
  854. getasz: procedure
  855. arg afsz
  856.  
  857. fsz = 0
  858. parse var afsz nm sz .
  859. kpos = index(sz,'K')
  860. mpos = index(sz,'M')
  861. select
  862.    when kpos > 0 then fsz=left(sz,kpos-1)
  863.    when mpos > 0 then fsz=left(sz,mpos-1)*1000
  864.    otherwise NOP
  865.    end
  866.  
  867. RETURN fsz
  868.  
  869.  
  870. readAmotd:
  871. if length(Amotd) < maxsgsz then
  872.    CALL givemsg('"'||Amotd||'"')
  873. else
  874.    CALL readmsg(Amotd)
  875.  
  876. RETURN
  877.  
  878.  
  879. sethttparg:
  880. parse arg dwldir
  881. if PRXY = "PRXY" | PRXY = "" then
  882.    hargs = ' OVERWRITE SD='||dwldir||' DEBUG='||dwldir||'HTTPdebug.log WINWIDTH=450 GUI NOERRREQ RXPORTFILE='
  883. else
  884.    hargs = ' OVERWRITE PROXY='||PRXY||' SD='||dwldir||' DEBUG='||dwldir||'HTTPdebug.log WINWIDTH=450 GUI NOERRREQ RXPORTFILE='
  885.  
  886. RETURN hargs
  887.  
  888.  
  889. readmsg: procedure
  890. parse arg msg
  891.  
  892. CALL open('w',"T:temp_msg",'w')
  893. CALL writeln('w',msg)
  894. CALL close('w')
  895. dopus read "T:temp_msg"
  896.  
  897. RETURN
  898.  
  899.  
  900. timedmsg:
  901. ADDRESS 'DOPUS.1'
  902. parse arg msg, dt
  903. lister set ALH title msg
  904. lister refresh ALH full
  905. CALL delay(dt)
  906. lister set ALH title topmsg
  907. lister refresh ALH full
  908.  
  909. RETURN
  910.  
  911.  
  912. givemsg:
  913. ADDRESS 'DOPUS.1'
  914. parse arg msg
  915. dopus request ''msg' OK'
  916.  
  917. RETURN
  918.  
  919.  
  920. tata:
  921. ADDRESS 'DOPUS.1'
  922. parse arg msg
  923. dopus request ''msg' OK'
  924. EXIT
  925.  
  926.  
  927. syntax:
  928. LF = '0a'x
  929. ADDRESS 'DOPUS.1'
  930. errmsg = '"ABORTING!"'||LF||'"Please report this error:"'||LF||'"Syntax Error "'||rc||'" , "'||"'"||errortext(rc)||"'"||'" in line "'||sigl||'"."'
  931. lister set ALH busy 0
  932. dopus request ''errmsg' OK'
  933. lister query ALH handler
  934. if result = handlername then CALL closeport(handlername)
  935. lister close ALH
  936. EXIT
  937.  
  938.